;;(1 ((2 3)(3 4)))=((1 2 3)(1 3 4))次优先级
(define (1-m-turple l)
    (let ((nl nil)(a (car l))(ll (cadr l)))
      (travel ll 'for-child i
	      (push (list a (car i) (cadr i)) nl))
      (reverse nl)))
;;(((2 3)(3 4)) 5)=((2 3 5)(3 4 5))次优先级
(define (m-1-turple l)
    (let ((nl nil)(ll (car l))(a (cadr l)))
      (travel ll 'for-child i
	      (push (list  (car i) (cadr i) a) nl))
      (reverse nl)))
;;((1 2 3) 5 (7 8 9))=((1 5 7)(2 5 8)(3 5 9))次优先级
(define (m-1-m-turple l)
    (let ((nl nil)(l1 (car l))(b (cadr l))(l2 (nth 2 l)))
      (travel l1 'for-index i
	      (push (list (nth i l1) b (nth i l2)) nl))
      (reverse nl)))
;;((1 2)(3 4)(5 6))=((1 2 3)(3 4 5)(4 5 6))最高优先级
(define (2-2-turple l)
    (let ((nl nil))
      (travel l 'for-index i
	      (cond ((and (consp (nth i l))(consp (nth (1+ i) l)))
		     (push (list (car (nth i l))(cadr (nth i l))(car (nth (1+ i) l))) nl))
		    ((or (null (cadr (nth i l)))(null (nth (1+ i) l))) nl)))
      (reverse nl)))
;;((1 2 3 4 5)(8 9))=((1 8 9)(2 8 9)(3 8 9)(4 8 9)(5 8 9))低优先级
(define (m-2-turple l)
    (let ((nl nil)(ll (car l))(b (cadr l)))
      (travel ll 'for-child i
	      (push (list i (car b)(cadr b)) nl))
      (reverse nl)))
;;((1 2)(3 4 5))=((1 2 3)(1 2 4)(1 2 5))低优先级
(define (2-m-turple l)
    (let ((nl nil)(b (car l))(ll (cadr l)))
      (travel ll 'for-child i
	      (push (list (car b)(cadr b) i) nl))
      (reverse nl)))

(define (read-st-file f)
    (let ((fn (format nil "~a.st" f))(new-chain nil)(ll nil))
    	(file-full-half fn)
      (with-open-file (fp fn)
	(when fp
	  (setf st-val (read fp nil))
	  (loop (when (null st-val) (return))
	     (setf new-chain (dup-removal-chain (concatenate 'list new-chain (st-check st-val))))
	     (setf st-val (read fp nil)))
	  new-chain))))
		     
(define (st-check l)
    (let ((len (if (consp l) (length l) 0)))
      (cond ((null l) (format t "ST not a NIL.[~a]~%" l) nil)
	    ((atom l) (format t "ST not a atom.[~a]~%" l) nil)
	    ((> len 3) (cond ((is-long-chain? l) (2-2-turple l))
			     ((is-aux-chain? l)  l)
			     (t (format t "ST has element(s) >3 or <2 or has diffrent atoms.") nil)))
	    ((= len 3) (cond ((is-3-turple? l) (list l))
			     ((is-m-1-m-turple? l) (m-1-m-turple l))
			     (t (format t "ST like [~a]-[~a]-[~a] is NOT permission." (length (car l)) (length (cadr l)) (length (nth 2 l))) nil)))
	    ((= len 2) (cond ((is-1-m-turple? l) (1-m-turple l))
			     ((is-m-1-turple? l) (m-1-turple l))
			     ((is-m-2-turple? l) (m-2-turple l))
			     ((is-2-m-turple? l) (2-m-turple l))
			     (t (format t "ST like [~a]-[~a] is NOT permission." (length (car l)) (length (cadr l))) nil)))
	    (t (format t "ST length is [~a] is NOT permission.~%" len) nil))))
(define (is-long-chain? l)
    (let ((flag t))
      (travel l 'for-child i
	      (if (and (consp i)(= (length i) 2)) (setf flag t)
		  (return-from is-long-chain? nil)))
      t))
(define (is-aux-chain? l)
    (let ((flag t))
      (travel l 'for-child i
	      (if (and (consp i)(= (length i) 3)) (setf flag t)
		  (return-from is-aux-chain? nil)))
      t))
(define (is-3-turple? l)
    (if (and (atom (car l))(is-act-func? (cadr l))(atom (nth 2 l))) t nil))
(define (is-act-func? l)
    (if (consp l)
	(cond ((eql (cadr l) '剩余字串) t)
	      (t nil))
	(if (atom l) t nil)))
  
(define (is-m-1-m-turple? l)
    (if (and (consp l)(= (length (car l))(length (nth 2 l)))(is-act-func? (cadr l))) t nil))
(define (is-1-m-turple? l)
    (let ((flag t))
      (if (atom (car l))
	(progn (travel (cadr l) 'for-child i
		       (if (and (consp i) (= (length i) 2)) (setf flag t)
			   (return-from is-1-m-turple? nil)))
	       t)
	nil)))
(define (is-2-m-turple? l)
    (let ((flag t))
      (if (and (consp (car l))(= (length (car l)) 2))
	(progn (travel (cadr l) 'for-child i
		       (if (atom i) (setf flag t)
			   (return-from is-2-m-turple? nil)))
	       t)
	nil)))
(define (is-m-1-turple? l)
    (let ((flag t))
      (if (atom (cadr l))
	(progn (travel (car l) 'for-child i
		       (if (and (consp i) (= (length i) 2)) (setf flag t)
			   (return-from is-m-1-turple? nil)))
	       t)
	nil)))
(define(is-m-2-turple? l)
     (let ((flag t))
      (if (and (consp (cadr l))(= (length (cadr l)) 2))
	(progn (travel (car l) 'for-child i
		       (if (atom i) (setf flag t)
			   (return-from is-m-2-turple? nil)))
	       t)
	nil)))
	 
